www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/sendpage.asp
<!--#include file=conn.asp-->
<!--#include file=config.asp-->
<!--#include file=const.asp-->
<!--#include file=char.asp-->
<!--#include file=inc/Email_Cls.asp-->
<%
'=========================================================
' File: sendpage.asp
' Version:3.0
' Date: 2005-11-5
' Script Written by xmrxw
'=========================================================
' Copyright (C) 2004,2005 920520.com All rights reserved.
' Web: http://www.920520.com,http://www.xmzxw.com
' Email: info@mssky.com,super@mssky.com
' QQ：10689579 Msn：zdlmicr@hotmail.com
'=========================================================
dim id,action
dim username
dim topic
dim mailbody,sendmsg
dim Useremail
dim content
dim postname
dim incepts
dim announce
dim Did,pageurl
stats="发送邮件"
if Cint(GroupSetting(9))=0 then
Errmsg=Errmsg+"<br>"+"<li>您没有将本页面发送的权限，请<a href=login.asp>登陆</a>或者同管理员联系。"
founderr=true
end if
if trim(request("id"))="" then
founderr=true
Errmsg=Errmsg+"<br>"+"<li>请指定相关内容。"
elseif not isInteger(trim(request("id"))) then
founderr=true
Errmsg=Errmsg+"<br>"+"<li>非法参数。"
else
ID=trim(request("id"))
end if
if trim(request("actsend"))="" then
founderr=true
Errmsg=Errmsg+"<br>"+"<li>请指定相关操作。"
end if
call nav()
if founderr then
call Mslove_error()
else
if request("action")="sendmail" then
if IsValidEmail(trim(Request.Form("mail")))=false then
errmsg=errmsg+"<br>"+"<li>您的Email有错误。</li>"
founderr=true
else
Useremail=trim(Request.Form("mail"))
end if
if request("postname")="" then
errmsg=errmsg+"<br>"+"<li>请输入您的姓名。</li>"
founderr=true
else
postname=request("postname")
end if
if request("incept")="" then
errmsg=errmsg+"<br>"+"<li>请输入收件人姓名。</li>"
founderr=true
else
incepts=request("incept")
end if
if request("content")="" or strLength(request("content"))>200 then
errmsg=errmsg+"<br>"+"<li>邮件内容不能为空长度不大于200个字符。</li>"
founderr=true
else
content=request("content")
end if
if founderr then
Mslove_error()
else
if founderr then
Mslove_error()
else
set rs=server.createobject("adodb.recordset")
if trim(request("actsend"))="diary" then'选择数据表(日记)
set rs=conn.execute("select title from Ms_diary where DID="&ID)
elseif trim(request("actsend"))="art" then'选择数据表（文章）
set rs=conn.execute("select title from Ms_Article where ID="&ID)
end if
if not(rs.bof and rs.eof) then
topic="您的朋友"&postname&"给您发来了一个"&webname&"上的文章"
else
foundErr = true
ErrMsg=ErrMsg+"<br>"+"<li>您指定的文章不存在</li>"
end if
rs.close
set rs=nothing
if foundErr = true then call Mslove_error()
if trim(request("actsend"))="diary" then'判断访问地址。
pageurl="您可以到<a href=http://"&request.servervariables("server_name")&replace(request.servervariables("script_name"),"sendpage.asp","")&"diaryview.asp?did="&id&">"&topic&"</a>这里浏览这篇文章<br>"
elseif trim(request("actsend"))="art" then'选择数据表（文章）
pageurl="您可以到<a href=http://"&request.servervariables("server_name")&replace(request.servervariables("script_name"),"sendpage.asp","")&"showart.asp?boardid="&request("boardid")&"&id="&id&">"&topic&"</a>这里浏览这篇文章<br>"
elseif trim(request("actsen"))="email" then'发送邮件
pageurl="<a href="&Homeurl&" target=_blank>"&webname&"</a>"
end if
mailbody="<html>"
mailbody=mailbody & "<title>交友中心邮件</title>"
mailbody=mailbody & "<body>"
mailbody=mailbody &"<TABLE border=0 width='95%' align=center><TBODY><TR><TD>"
mailbody=mailbody &""&incepts&"，您好：<br><br>"
if trim(request("actsen"))="email" then'发送邮件
mailbody=mailbody &"您的朋友"&postname&"给您发来邮件！<BR><br>"
mailbody=mailbody &"标题是："&htmlencode(topic)&"<br><br>"
else
mailbody=mailbody &"您的朋友"&postname&"给您发来了一个"&webname&"上的文章<BR><br>"
mailbody=mailbody &"标题是："&htmlencode(topic)&"<br><br>"
end if
mailbody=mailbody &""&htmlencode(content)&"<br><br>"
mailbody=mailbody &""&pageurl&""
mailbody=mailbody &""&Copyright&" "&Versions&""
mailbody=mailbody &"</TD></TR></TBODY></TABLE>"
mailbody=mailbody & "</body>"
mailbody=mailbody & "</html>"
Dim DvEmail
Set DvEmail = New Dv_SendMail
DvEmail.SendObject = Cint(Mailtype) '设置选取组件 1=Jmail,2=Cdonts,3=Aspemail,0不支持
DvEmail.ServerLoginName = Mailuser '您的邮件服务器登录名
DvEmail.ServerLoginPass = Mailpass '登录密码
DvEmail.SendSMTP = Mailsmtp 'SMTP地址
DvEmail.SendFromEmail = Mailsend '发送来源地址
DvEmail.SendFromName = Webname '发送人信息
If DvEmail.ErrCode = 0 Then
DvEmail.SendMail useremail,topic,mailbody '执行发送邮件
If DvEmail.Count>0 Then
sendmsg="<li>邮件已经发送成功</li>"
Else
sendmsg="<li>由于系统错误，邮件发送不成功</li>"
End If
Else
sendmsg="<li>由于系统错误，邮件不能发送！</li>"
End If
Set DvEmail = Nothing
sucmsg=sucmsg+"<br>"+sendmsg
call Mslove_suc()
end if
end if
else
call pag()
end if
call activeonline()
end if
call footer()
sub pag()
%>
<table cellpadding=3 cellspacing=1 align=center class=tableborder1>
<form action="sendpage.asp?action=sendmail&actsend=<%=request("actsend")%>&id=<%=id%>" method=post>
<tr>
<th valign=middle colspan=2>发送邮件给朋友</th></tr>
<tr>
<td class=tablebody1 valign=middle colspan=2> <b>通过邮件发送本内容给您的朋友。</b> 下列所有项必填，并请输入正确的邮件地址！
<br>
你可以添加一些自己的信息在下面的内容框内。至于这个文章的主题和 URL 你可以不必写，因为本程序会在发送的 Email 中自动添加的！ </td>
</tr>
<tr>
<td class=tablebody1><b>您的姓名：</b></td>
<td class=tablebody1><input type=text size=40 name="postname" value="<%=Trim(membername)%>">
<b>默认为您的登录名</b></td>
</tr><tr>
<td class=tablebody1><b>您朋友的名字：</b></td>
<td class=tablebody1><input type=text size=40 name="incept"></td>
</tr><tr>
<td class=tablebody1><b>您朋友的 Email：</b></td>
<td class=tablebody1><input type=text size=40 name="mail"></td>
</tr><tr>
<td class=tablebody1><b>消息内容：</b></td>
<td class=tablebody1><textarea name="content" cols="55" rows="6">
我想你对 '<%=webname%>' 的这篇文章内容会感兴趣的！请去看看！</textarea></td>
</tr><tr>
<td colspan=2 class=tablebody2 align=center><input type=submit value="发 送" name="Submit"></td></tr></form></table>
<%end sub%>